Initial Set Up Steps
library(shinydashboard)
library(tidyverse)
library(leaflet)
library(shiny)
library(sf)
library(htmlwidgets)
library(googlesheets4)
library(RColorBrewer)
library(lubridate)
library(purrr)
library(censusapi)
library(rgeos)
library(tidycensus)
library(tigris)
library(usmap)
library(colorspace)
library(ggplot2)
library(reshape2)
library(formattable)
library(plotly)
Sys.setenv(CENSUS_KEY="c8aa67e4086b4b5ce3a8717f59faa9a28f611dab")
github_directory <- "https://raw.githubusercontent.com/stanfordfuturebay/stanfordfuturebay.github.io/master/data/"
github_rds <- "https://github.com/stanfordfuturebay/stanfordfuturebay.github.io/blob/master/data/"
options(
tigris_class = "sf",
tigris_use_cache = TRUE
)
mapbox_sat <- "https://api.mapbox.com/styles/v1/samanyl/ck9hpl0sm0fuq1ip8yfb2yrn8/tiles/256/{z}/{x}/{y}@2x?access_token=pk.eyJ1Ijoic2FtYW55bCIsImEiOiJjazlocGNvYWgxMHhxM2Rud2pxdzVnMnp2In0.D_j3K9tXiEddHH-8UUkeZQ"
mapbox_satAtt <- "© <a href='https://www.mapbox.com/map-feedback/'>Mapbox</a> Satellite Map"
bay_county_names <-
c(
"Alameda",
"Contra Costa",
"Marin",
"Napa",
"San Francisco",
"San Mateo",
"Santa Clara",
"Solano",
"Sonoma"
)
bay_counties <- readRDS(gzcon(url(paste0(github_rds,"bay_counties.rds?raw=true"))))
setwd("C:/Users/liusa/github/covid19/snap project/sam")
# bay_counties <-
# counties("CA", cb = F, progress_bar=F) %>%
# filter(NAME %in% bay_county_names)
#
# zctas <-
# zctas(cb=F)
#
# bay_zctas <-
# zctas %>%
# dplyr::select(ZCTA5CE10) %>%
# st_join(bay_counties %>% dplyr::select(geometry),left=F)
#
# saveRDS(bay_zctas, file = "bay_zctas.rds")
sheets_deauth()
retailers <-
read_sheet("1tvMBCWNeh7kyyKklntmWfV1zNJx8bN-KxHIYmaULZxg")
retailers$long <- as.numeric(retailers$long)
retailers$lat <- as.numeric(retailers$lat)
snap <- retailers %>% filter(type == "SNAP_accepting_retailer")
wic <- retailers %>% filter(type == "WIC_only_store")
snap_wic <- retailers %>% filter(type == "WIC_SNAP_retailer")
snap_restaurant <- retailers %>% filter(type=="SNAP_restaurant")
snap_farmers <- retailers %>% filter(type=="SNAP_farmers_market")
snap_curbside <- snap %>% filter(!is.na(curbside_pickup))
wic_curbside <- wic %>% filter(!is.na(curbside_pickup))
snapwic_curbside <- snap_wic %>% filter(!is.na(curbside_pickup))
snaprest_curbside <- snap_restaurant %>% filter(!is.na(curbside_pickup))
snapfarm_curbside <- snap_farmers %>% filter(!is.na(curbside_pickup))
snap_delivery <- snap %>% filter(!is.na(delivery))
wic_delivery <- wic %>% filter(!is.na(delivery))
snapwic_delivery <- snap_wic %>% filter(!is.na(delivery))
snaprest_delivery <- snap_restaurant %>% filter(!is.na(delivery))
snapfarm_delivery <- snap_farmers %>% filter(!is.na(delivery))
snap_senior <- snap %>% filter(!is.na(senior_hours))
wic_senior <- wic %>% filter(!is.na(senior_hours))
snapwic_senior <- snap_wic %>% filter(!is.na(senior_hours))
snaprest_senior <- snap_restaurant %>% filter(!is.na(senior_hours))
snapfarm_senior <- snap_farmers %>% filter(!is.na(senior_hours))
snapIcon <- makeIcon(
iconUrl = "baymap/bag.png",
iconWidth=25,iconHeight=25)
wicIcon <- makeIcon(
iconUrl = "baymap/love.png",
iconWidth=30,iconHeight=30)
snapwicIcon <- makeIcon(
iconUrl = "baymap/snapwic.png",
iconWidth=30,iconHeight=30)
snaprestIcon <- makeIcon(
iconUrl = "baymap/cutlery.png",
iconWidth=25,iconHeight=25)
snapfarmIcon <- makeIcon(
iconUrl = "baymap/chicken.png",
iconWidth=25,iconHeight=25)
homeIcon <- makeIcon(
iconUrl = "baymap/internet.png",
iconWidth=25,iconHeight=25)
html_legend <- "<img src='https://raw.githubusercontent.com/stanfordfuturebay/stanfordfuturebay.github.io/master/data/bag.png' height='30' width='30'> SNAP Only Retailers<br/><img src='https://raw.githubusercontent.com/stanfordfuturebay/stanfordfuturebay.github.io/master/data/love.png' height='30' width='30'> WIC Only Retailers<br/><img src='https://raw.githubusercontent.com/stanfordfuturebay/stanfordfuturebay.github.io/master/data/snapwic.png' height='30' width='30'> SNAP and WIC Accepting Retailers<br/><img src='https://raw.githubusercontent.com/stanfordfuturebay/stanfordfuturebay.github.io/master/data/money.png' height='30' width='30'> Cash EBT Withdrawal Locations<br/><img src='https://raw.githubusercontent.com/stanfordfuturebay/stanfordfuturebay.github.io/master/data/cutlery.png' height='30' width='30'> SNAP Accepting Restaurants<br/><img src='https://raw.githubusercontent.com/stanfordfuturebay/stanfordfuturebay.github.io/master/data/chicken.png' height='30' width='30'> SNAP Accepting Farmers Markets"
cluster <-
markerClusterOptions(
showCoverageOnHover=F,
spiderfyOnMaxZoom=F,
disableClusteringAtZoom=14
)
# time format --> format(dataset$____, %I:%M%p)
pop <- function(dataset){
result <-
paste0(
ifelse(
is.na(dataset$web_link),
paste0("<strong>",dataset$site_name,"</strong><br>"),
paste0("<a href='",dataset$web_link,"' target='_blank'><strong>",dataset$site_name,"</strong></a><br>")
),
dataset$address, "<br>",
dataset$city,", ",
dataset$state," ",
dataset$zip,
"<br><br><img src='https://raw.githubusercontent.com/stanfordfuturebay/stanfordfuturebay.github.io/master/data/pin.png' height='12' width='12'>
<a href='https://www.google.com/maps/dir/?api=1&destination=",
dataset$lat,",",
dataset$long,"' target='_blank'>Directions To Here</a>",
'<br><br><strong>Hours of Operation: </strong><br>',
dataset$days_hours_line1,
ifelse(
is.na(dataset$days_hours_line2),
"",
paste0("<br>",dataset$days_hours_line2)
),
ifelse(
is.na(dataset$days_hours_line3),
"",
paste0("<br>",dataset$days_hours_line3)
),
ifelse(
is.na(dataset$days_hours_line4),
"",
paste0("<br>",dataset$days_hours_line4)
),
"<br><br><strong>Contact Information:</strong><br>",
ifelse(
is.na(dataset$facebook),
"",
paste0("<a href='",dataset$facebook,"' target='_blank'>Facebook</a><br>")
),
dataset$phone,"<br>",
ifelse(
is.na(dataset$notes),
"",
paste0("<br><strong>Notes: </strong>",dataset$notes,"<br>")
),
ifelse(
is.na(dataset$senior_hours),
"",
paste0(
'<br><strong style="color:red">** SPECIAL SENIOR HOURS ** </strong><br>',
dataset$senior_hours)
)
)
return(result)
}
bay_zctas <- readRDS("P:/Stanford/Classes/CEE218Z - Shaping the Future of the Bay/bay_zctas.rds")
wd <- "P:/Shared/SFBI/Restricted Data Library/Safegraph/covid19analysis/transactions-facteus/"
combining <- function(pattern) {
files <- list.files(pattern = pattern)
return(do.call(rbind, lapply(files,readRDS)))
}
spending_total <- readRDS(paste0(wd,"cut-1-daily-spend-by-zip/2020-04-22/cut-1-daily-spend-by-zip-20170101-20200417-bay.rds"))
setwd(paste0(wd,"cut-2-daily-spend-by-zip-by-mcc/2020-04-22"))
spending_MCC <-
combining("cut-2-daily-spend-by-zip-by-mcc-20170101-20200417-[0-1][0-9]-bay.rds")
setwd(paste0(wd,"cut-3-daily-spend-by-brand/2020-04-22"))
spending_brand <- combining("daily-spend-by-brand-20170101-20200417-[0-1][0-9]-bay.rds")
walmart_instore <- readRDS(paste0(wd,"cut-4-daily-spend-at-walmart/2020-04-22/daily-spend-by-zip-walmart-instore-20170101-20200417-bay.rds"))
walmart_online <- readRDS(paste0(wd,"cut-4-daily-spend-at-walmart/2020-04-22/daily-spend-by-zip-walmart-online-20170101-20200417-bay.rds"))
setwd("C:/Users/liusa/github/covid19/snap project/sam")
Leaflet Snap Circle Icons
cols <- brewer.pal(5, name='Set1')
retail.col <- colorFactor(cols, domain = c("SNAP_accepting_retailer","WIC_only_store","WIC_SNAP_retailer","SNAP_restaurant",
"SNAP_farmers_market"))
mpc <- leaflet() %>%
addProviderTiles(providers$CartoDB.VoyagerLabelsUnder, group = "Default") %>%
addTiles(urlTemplate = mapbox_sat, attribution = mapbox_satAtt, group = "Satellite") %>%
addCircleMarkers(
lng = retailers$long,
lat = retailers$lat,
clusterOptions = cluster,
color = retail.col(retailers$type),
radius = 5,
popup = pop(retailers)
) %>%
addLegend(
position = 'bottomleft',
values = subset(retailers$type,!is.na(retailers$type)),
na.label = "",
pal = retail.col,
title='Stores'
) %>%
addLayersControl(
baseGroups = c("Default","Satellite")
)
mpc
Leaflet Snap with Flat Icons
mpi <- leaflet() %>%
addProviderTiles(providers$CartoDB.VoyagerLabelsUnder, group = "Default") %>%
# addProviderTiles(providers$CartoDB.Positron, group = "Positron") %>% # add mapbox
addTiles(urlTemplate = mapbox_sat, attribution = mapbox_satAtt, group = "Satellite") %>%
addMarkers(
lng = snap$long,
lat = snap$lat,
clusterOptions = cluster,
popup = pop(snap),
icon = snapIcon,
group = "SNAP Only Retailers"
) %>%
addMarkers(
lng = wic$long,
lat = wic$lat,
clusterOptions = cluster,
popup = pop(wic),
icon = wicIcon,
group = "WIC Only Retailers"
) %>%
addMarkers(
lng = snap_wic$long,
lat = snap_wic$lat,
clusterOptions = cluster,
popup = pop(snap_wic),
icon = snapwicIcon,
group = "SNAP and WIC Accepting Retailers"
) %>%
addMarkers(
lng = snap_restaurant$long,
lat = snap_restaurant$lat,
clusterOptions = cluster,
popup = pop(snap_restaurant),
icon = snaprestIcon,
group = "SNAP Accepting Restaurants"
) %>%
addMarkers(
lng = snap_farmers$long,
lat = snap_farmers$lat,
clusterOptions = cluster,
popup = pop(snap_farmers),
icon = snapfarmIcon,
group = "SNAP Accepting Farmers Markets"
) %>%
addMarkers(
lng = snap_curbside$long,
lat = snap_curbside$lat,
clusterOptions = cluster,
popup = pop(snap_curbside),
icon = snapIcon,
group = "Offers Curbside Pick-up"
) %>%
addMarkers(
lng = wic_curbside$long,
lat = wic_curbside$lat,
clusterOptions = cluster,
popup = pop(wic_curbside),
icon = wicIcon,
group = "Offers Curbside Pick-up"
) %>%
addMarkers(
lng = snapwic_curbside$long,
lat = snapwic_curbside$lat,
clusterOptions = cluster,
popup = pop(snapwic_curbside),
icon = snapwicIcon,
group = "Offers Curbside Pick-up"
) %>%
addMarkers(
lng = snaprest_curbside$long,
lat = snaprest_curbside$lat,
clusterOptions = cluster,
popup = pop(snaprest_curbside),
icon = snaprestIcon,
group = "Offers Curbside Pick-up"
) %>%
addMarkers(
lng = snapfarm_curbside$long,
lat = snapfarm_curbside$lat,
clusterOptions = cluster,
popup = pop(snapfarm_curbside),
icon = snapfarmIcon,
group = "Offers Curbside Pick-up"
) %>%
addMarkers(
lng = snap_delivery$long,
lat = snap_delivery$lat,
clusterOptions = cluster,
popup = pop(snap_delivery),
icon = snapIcon,
group = "Offers CSA Box Delivery"
) %>%
addMarkers(
lng = wic_delivery$long,
lat = wic_delivery$lat,
clusterOptions = cluster,
popup = pop(wic_delivery),
icon = wicIcon,
group = "Offers CSA Box Delivery"
) %>%
addMarkers(
lng = snapwic_delivery$long,
lat = snapwic_delivery$lat,
clusterOptions = cluster,
popup = pop(snapwic_delivery),
icon = snapwicIcon,
group = "Offers CSA Box Delivery"
) %>%
addMarkers(
lng = snaprest_delivery$long,
lat = snaprest_delivery$lat,
clusterOptions = cluster,
popup = pop(snaprest_delivery),
icon = snaprestIcon,
group = "Offers CSA Box Delivery"
) %>%
addMarkers(
lng = snapfarm_delivery$long,
lat = snapfarm_delivery$lat,
clusterOptions = cluster,
popup = pop(snapfarm_delivery),
icon = snapfarmIcon,
group = "Offers CSA Box Delivery"
) %>%
addMarkers(
lng = snap_senior$long,
lat = snap_senior$lat,
clusterOptions = cluster,
popup = pop(snap_senior),
icon = snapIcon,
group = "Offers Senior Hours"
) %>%
addMarkers(
lng = wic_senior$long,
lat = wic_senior$lat,
clusterOptions = cluster,
popup = pop(wic_senior),
icon = wicIcon,
group = "Offers CSA Box Delivery"
) %>%
addMarkers(
lng = snapwic_senior$long,
lat = snapwic_senior$lat,
clusterOptions = cluster,
popup = pop(snapwic_senior),
icon = snapwicIcon,
group = "Offers CSA Box Delivery"
) %>%
addMarkers(
lng = snaprest_senior$long,
lat = snaprest_senior$lat,
clusterOptions = cluster,
popup = pop(snaprest_senior),
icon = snaprestIcon,
group = "Offers CSA Box Delivery"
) %>%
addMarkers(
lng = snapfarm_senior$long,
lat = snapfarm_senior$lat,
clusterOptions = cluster,
popup = pop(snapfarm_senior),
icon = snapfarmIcon,
group = "Offers CSA Box Delivery"
) %>%
addLayersControl(
baseGroups = c("Default","Mapbox Basemap","Satellite"),
overlayGroups = c("SNAP Only Retailers","WIC Only Retailers","SNAP and WIC Accepting Retailers","Cash EBT Withdrawal Locations",
"SNAP Accepting Restaurants","SNAP Accepting Farmers Markets")
) %>%
addControl(
html=html_legend,
position="bottomleft") %>%
hideGroup(c("Offers Curbside Pick-up", "Offers CSA Box Delivery","Offers Senior Hours"))
mpi
2019 vs 2020 Spending Trends Between January and April
## Question: ask derek how to normalize based on sample size/population
## Side Project: how to cumulate zipcodes by county
## Next Steps: overlay with snap users zipcode data, normalize walmart analysis data correctly, put bar charts on shiny (UIoutput) - be able to have two side-by-side comparison
# spending distribution of products (bar charts)
# spending_MCC_sum <-
# spending_MCC %>%
# mutate(year=substr(date,1,4)) %>%
# mutate(month = substr(date,6,7)) %>%
# group_by(year,month,MCC) %>%
# summarize(
# mean=mean(as.numeric(total_spent)),
# sum=sum(as.numeric(total_spent)),
# transactions=sum(as.numeric(transaction_counts)),
# avg_transactions=mean(as.numeric(transaction_counts)))
#
# spending_MCC_1920 <-
# spending_MCC_sum %>%
# filter(year %in% c("2019","2020"), month %in% c("01","02","03","04"), MCC > 0)
#
# spending_MCC_1920 <-
# spending_MCC_1920[order(spending_MCC_1920$MCC),]
#
# spending_MCC_1920 <-
# spending_MCC_1920[-c(1,2,3,4),]
#
# saveRDS(spending_MCC_1920,"baymap/spending_MCC_1920.rds")
mcc_codes <-
read_csv("https://raw.githubusercontent.com/greggles/mcc-codes/master/mcc_codes.csv") %>%
dplyr::select(
MCC = mcc,
label = edited_description
)
spending_MCC_1920 <- readRDS("baymap/spending_MCC_1920.rds")
plot_month <- function(m,abbr) {
spend20 <-
spending_MCC_1920 %>%
filter(month==m,year=="2020")
spend1920 <-
spending_MCC_1920 %>%
filter(month==m,year=="2019") %>%
right_join(spend20,by=c("MCC","month"),suffix=c("_2019","_2020")) %>%
filter(!is.na(transactions_2019) & !is.na(transactions_2020) & !is.na(year_2019) & !is.na(year_2020))
spend1920 <-
spend1920[order(spend1920$transactions_2020),]
spend1920 <-
spend1920 %>%
tail(10) %>%
left_join(mcc_codes,by=("MCC")) %>%
dplyr::select(-MCC) %>%
dplyr::select(year_2019,year_2020,transactions_2019,transactions_2020,label)
spend1920 <- spend1920[c("label", "year_2019", "year_2020", "transactions_2019", "transactions_2020")]
spend20 <-
spend1920 %>%
dplyr::select(year_2020,transactions_2020,label) %>%
dplyr::rename("year" = "year_2020","transactions"="transactions_2020")
spend19 <-
spend1920 %>%
dplyr::select(year_2019,transactions_2019,label) %>%
dplyr::rename("year" = "year_2019","transactions"="transactions_2019")
spend1920_plt <-
spend19 %>%
full_join(spend20) %>%
ungroup()
plt <-
ggplot(spend1920_plt,aes(x=label,y=transactions,fill=year,group=year)) +
scale_fill_brewer(palette="Paired") +
geom_bar(stat="identity",position=position_dodge()) +
coord_flip() +
ggtitle(paste0("Distribution of Spendings by MCC - ",abbr)) +
theme_minimal() +
theme(axis.text.x =element_blank())
# plt <-
# plt %>%
# ggplotly() %>%
# config(displayModeBar = F)
spend1920_tbl <-
spend1920 %>%
dplyr::select(label, transactions_2019,transactions_2020) %>%
dplyr::rename("2019 Transactions" = "transactions_2019","2020 Transactions"="transactions_2020","MCC Description"="label") %>%
formattable(align = c("l", rep("c", NCOL(spend1920) - 1)))
values <- list("plt" = plt,"tbl" = spend1920_tbl)
return(values)
}
jan <- plot_month("01","Jan")
jan$plt

jan$tbl
|
MCC Description
|
2019 Transactions
|
2020 Transactions
|
|
Automated Fuel Dispensers
|
44456
|
43278
|
|
Money Orders – Wire Transfer
|
13581
|
43782
|
|
Misc. Food Stores – Convenience Stores and Specialty Markets
|
40627
|
49610
|
|
Financial Institutions – Manual Cash Disbursements
|
45488
|
66778
|
|
Taxicabs and Limousines
|
81206
|
74901
|
|
Eating places and Restaurants
|
139639
|
150149
|
|
Miscellaneous and Specialty Retail Stores
|
204483
|
179750
|
|
Service Stations ( with or without ancillary services)
|
130722
|
189541
|
|
Grocery Stores, Supermarkets
|
152744
|
189982
|
|
Fast Food Restaurants
|
236911
|
300474
|
feb <- plot_month("02","Feb")
feb$plt

feb$tbl
|
MCC Description
|
2019 Transactions
|
2020 Transactions
|
|
Money Orders – Wire Transfer
|
15253
|
44139
|
|
Automated Fuel Dispensers
|
42562
|
49137
|
|
Misc. Food Stores – Convenience Stores and Specialty Markets
|
41143
|
56096
|
|
Financial Institutions – Manual Cash Disbursements
|
47793
|
85592
|
|
Taxicabs and Limousines
|
84758
|
89658
|
|
Service Stations ( with or without ancillary services)
|
125513
|
142621
|
|
Grocery Stores, Supermarkets
|
151210
|
160088
|
|
Eating places and Restaurants
|
144215
|
186259
|
|
Fast Food Restaurants
|
236745
|
301869
|
|
Miscellaneous and Specialty Retail Stores
|
203356
|
325414
|
mar <- plot_month("03","Mar")
mar$plt

mar$tbl
|
MCC Description
|
2019 Transactions
|
2020 Transactions
|
|
Record Shops
|
23904
|
46108
|
|
Money Orders – Wire Transfer
|
18707
|
48890
|
|
Misc. Food Stores – Convenience Stores and Specialty Markets
|
50274
|
59528
|
|
Taxicabs and Limousines
|
100191
|
68208
|
|
Financial Institutions – Manual Cash Disbursements
|
56766
|
79597
|
|
Service Stations ( with or without ancillary services)
|
148208
|
140964
|
|
Eating places and Restaurants
|
177563
|
148624
|
|
Grocery Stores, Supermarkets
|
170894
|
180237
|
|
Fast Food Restaurants
|
284305
|
261753
|
|
Miscellaneous and Specialty Retail Stores
|
243923
|
310774
|
apr <- plot_month("04","Apr")
apr$plt

apr$tbl
|
MCC Description
|
2019 Transactions
|
2020 Transactions
|
|
Book Stores
|
26974
|
25455
|
|
Record Shops
|
29313
|
28662
|
|
Misc. Food Stores – Convenience Stores and Specialty Markets
|
50755
|
30979
|
|
Money Orders – Wire Transfer
|
19355
|
37603
|
|
Financial Institutions – Manual Cash Disbursements
|
56793
|
41980
|
|
Eating places and Restaurants
|
166319
|
61977
|
|
Service Stations ( with or without ancillary services)
|
145971
|
70446
|
|
Grocery Stores, Supermarkets
|
162668
|
89860
|
|
Fast Food Restaurants
|
282207
|
107498
|
|
Miscellaneous and Specialty Retail Stores
|
258077
|
129933
|
Online vs. Instore Spending Trends Due to SIP Orders
# compare instore to online ratio and potential for the online shift before and after covid
# transactions_ratio >> on a given day, ___ times more people shop instores rather than online (2 line graph showing the trend before and after covid and online vs instore trends)
# walmart_instore_sum <-
# walmart_instore %>%
# mutate(month = substr(date,1,7)) %>%
# group_by(month) %>%
# summarize(
# mean=mean(as.numeric(total_spent)),
# sum=sum(as.numeric(total_spent)),
# avg_transactions=mean(as.numeric(transaction_counts)),
# transactions=sum(as.numeric(transaction_counts)))
#
# walmart_sum <-
# walmart_online %>%
# mutate(month = substr(date,1,7)) %>%
# group_by(month) %>%
# summarize(
# mean=mean(as.numeric(total_spent)),
# sum=sum(as.numeric(total_spent)),
# avg_transactions=mean(as.numeric(transaction_counts)),
# transactions=sum(as.numeric(transaction_counts))) %>%
# left_join(walmart_instore_sum,by="month",suffix=c("_online","_instore"))
#
# walmart_melt <-
# walmart_sum %>%
# tail(13) %>%
# mutate(transactions_ratio_instore=(avg_transactions_instore)/(sum(walmart_sum[, 'avg_transactions_instore']))) %>%
# mutate(transactions_ratio_online=(avg_transactions_online)/(sum(walmart_sum[, 'avg_transactions_online']))) %>%
# dplyr::select(month,transactions_ratio_instore,transactions_ratio_online) %>%
# melt(id=c("month"))
#
# saveRDS(walmart_melt,"baymap/walmart_transactions.rds")
walmart_melt <- readRDS("baymap/walmart_transactions.rds")
wplt <-
ggplot(walmart_melt,aes(x=month,y=value,color=variable,group=variable)) +
geom_line(size=1.5) +
labs(y= "Transactions Ratio", x = "Date", color="Legend") +
theme(axis.text.y =element_blank(),
axis.ticks.y=element_blank())
wplt

# instore1920 <-
# walmart_instore %>%
# mutate(year = substr(date,1,4)) %>%
# mutate(month = substr(date,6,7)) %>%
# mutate(day = substr(date,9,10)) %>%
# mutate(month_day = substr(date,6,10) %>% as.Date("%m-%d")) %>%
# filter(month %in% c("01","02","03","04") & year %in% c("2019","2020")) %>%
# group_by(year,month_day) %>%
# summarize(
# avg_transactions=mean(as.numeric(transaction_counts))) %>%
# spread(year,avg_transactions) %>%
# mutate(transactions_ratio=`2020`/`2019`)
#
# instore_online_1920 <-
# walmart_online %>%
# mutate(year = substr(date,1,4)) %>%
# mutate(month = substr(date,6,7)) %>%
# mutate(day = substr(date,9,10)) %>%
# mutate(month_day = substr(date,6,10) %>% as.Date("%m-%d")) %>%
# filter(month %in% c("01","02","03","04") & year %in% c("2019","2020")) %>%
# group_by(year,month_day) %>%
# summarize(
# avg_transactions=mean(as.numeric(transaction_counts))) %>%
# spread(year,avg_transactions) %>%
# mutate(transactions_ratio=`2020`/`2019`) %>%
# left_join(instore1920,suffix=c("_online","_instore"),by=c("month_day")) %>%
# dplyr::select(month_day,transactions_ratio_online,transactions_ratio_instore) %>%
# melt(id=c("month_day")) %>%
# arrange(month_day) %>%
# na.omit()
#
# saveRDS(instore_online_1920,"baymap/instore_online_1920.rds")
instore_online_1920 <- readRDS("baymap/instore_online_1920.rds")
ioplt <-
ggplot(instore_online_1920,aes(x=month_day,y=value,color=variable,group=1)) +
geom_line(size=1) +
labs(y= "Transactions Ratio", x = "Month-Day", color="Legend")
ioplt %>% ggplotly()
Grocers Spending Trends
# show trends over the years
# spending impacts due to covid (line graphs by MCC)
# spending_grocers <-
# spending_MCC %>%
# filter(MCC=="5411")
# mutate(month = substr(date,6,7)) %>%
# mutate(year = substr(date,1,4)) %>%
# mutate(day = substr(date,9,10)) %>%
# filter(month %in% c("01","02","03","04") & year %in% c("2019", "2020")) %>%
# group_by(year,month, day) %>%
# summarize(
# mean=mean(as.numeric(total_spent)),
# sum=sum(as.numeric(total_spent)),
# avg_transactions=mean(as.numeric(transaction_counts)),
# transactions=sum(as.numeric(transaction_counts)))
#
# saveRDS(spending_grocers,"baymap/spending_grocers_daily.rds")
spending_grocers <- readRDS("baymap/spending_grocers_daily.rds")
plot_grocers <- function(m) {
grocers <-
spending_grocers %>%
filter(month==m) %>%
ungroup()
gplt <-
ggplot(grocers,aes(x=day,y=avg_transactions,color=year,group=year)) +
geom_line(size=1.5) +
scale_color_brewer(palette = "Paired") +
labs(y= "Transactions", x = "Day") +
theme_minimal()
gplt <-
gplt %>%
ggplotly() %>%
config(displayModeBar = F)
return(gplt)
}
jan_grocers <- plot_grocers("01")
jan_grocers
feb_grocers <- plot_grocers("02")
feb_grocers
mar_grocers <- plot_grocers("03")
mar_grocers
apr_grocers <- plot_grocers("04")
apr_grocers
Walmart vs. SNAP Demographics
# # most popular/accessible walmart among zipcodes (plot number of transactions on map)
# spending_brand_sum <-
# spending_brand %>%
# group_by(merchant,zip) %>%
# filter(merchant=="WALMART") %>%
# summarize(
# mean=mean(as.numeric(total_spent)),
# sum=sum(as.numeric(total_spent)),
# transactions_sum=sum(as.numeric(transaction_counts)),
# transactions_avg=mean(as.numeric(transaction_counts))) %>%
# left_join(bay_zctas,by=c("zip"="ZCTA5CE10")) %>%
# distinct(zip,.keep_all = T) %>%
# st_as_sf(dim = "XY", sf_column_name = "geometry") %>%
# st_transform(crs=4326)
#
# spending_brand_sum <- spending_brand_sum[order(spending_brand_sum$transactions_avg),]
## normalize based on population
spending_brand_sum <- readRDS("baymap/spending_brand_sum.rds")
spending_brand_sum_top5 <- tail(spending_brand_sum,5)
spending_brand_sum_top10 <- tail(spending_brand_sum,10)
# saveRDS(spending_brand_sum,"spending_brand_sum.rds")
pal <- sequential_hcl("red-blue",n=3,rev=T)
col <- colorNumeric(pal,domain=spending_brand_sum$transactions_avg)
fp <- leaflet() %>%
addProviderTiles(providers$CartoDB.VoyagerLabelsUnder, group = "Default") %>%
addTiles(urlTemplate = mapbox_sat, attribution = mapbox_satAtt, group = "Satellite") %>%
addPolygons(
data = spending_brand_sum,
color = col(spending_brand_sum$transactions_avg),
weight=1,
popup = paste0(
"<strong>",spending_brand_sum$zip,"</strong><br>",
spending_brand_sum$transactions_avg),
labelOptions = labelOptions(
style = list("font-weight" = "normal", padding = "3px 8px"),
textsize = "15px",
direction = "auto"),
group = "All"
) %>%
addPolygons(
data = spending_brand_sum_top5,
weight=2,
color = "red",
popup = paste0(
"<strong>",spending_brand_sum_top5$zip,"</strong><br>",
spending_brand_sum_top5$transactions_avg),
labelOptions = labelOptions(
style = list("font-weight" = "normal", padding = "3px 8px"),
textsize = "15px",
direction = "auto"),
group = "Top 5"
) %>%
addPolygons(
data = spending_brand_sum_top10,
color = "red",
weight=2,
popup = paste0(
"<strong>",spending_brand_sum_top10$zip,"</strong><br>",
spending_brand_sum_top10$transactions_avg),
labelOptions = labelOptions(
style = list("font-weight" = "normal", padding = "3px 8px"),
textsize = "15px",
direction = "auto"),
group = "Top 10"
) %>%
addLegend(
position = 'bottomleft',
values = spending_brand_sum$transactions_avg,
pal = col,
title='Avg Daily Walmart Transactions'
) %>%
addLayersControl(
baseGroups = c("Default","Satellite"),
overlayGroups = c("All","Top 5","Top 10")
) %>%
hideGroup(c("Top 5","Top 10"))
fp
Shiny App Implementation